home *** CD-ROM | disk | FTP | other *** search
/ Aminet 22 / Aminet 22 (1997)(GTI - Schatztruhe)[!][Dec 1997].iso / Aminet / dev / basic / dbview2_ace105.lha / dbview2_ace / dbview2.b < prev    next >
Text File  |  1997-09-06  |  9KB  |  312 lines
  1. GOTO SkipVer {*** version string ***}
  2. ASSEM
  3. EVEN
  4. DC.B "$VER: dBView 1.0.5 (28.03.97)"
  5. EVEN
  6. END ASSEM
  7. SkipVer:
  8.  
  9. WINDOW 5,"dBView 1.0.5",(0,0)-(640,200)
  10. DEFLNG a - z {*** for speed reasons ***}
  11. CONST DBFBUFLEN&=4097 {*** Buffer length ***}
  12. DIM q&(257) {*** holds field lengths ***}
  13. ext$=".DBF" {*** default file name extension ***}
  14. reverse$=empty$ {*** empty$ is empty ***}
  15.  
  16. {*** SUB declarations ***}
  17.  
  18. DECLARE SUB STRING ibm2ansi(cvi$)
  19. DECLARE SUB STRING trim(a$)
  20. DECLARE SUB XBCVI(a$)
  21. DECLARE SUB XBCVL(a$)
  22.  
  23. LIBRARY "exec.library"
  24. DECLARE FUNCTION AllocMem&(l&,r&) LIBRARY "exec"
  25. DECLARE FUNCTION FreeMem&(b&,l&) LIBRARY "exec"
  26.  
  27. LIBRARY "dos.library"
  28. DECLARE FUNCTION _Open&(n&,m&) LIBRARY "dos"
  29. DECLARE FUNCTION _Close&(fh&) LIBRARY "dos"
  30. DECLARE FUNCTION _Read&(fh&,buf&,l&) LIBRARY "dos"
  31. DECLARE FUNCTION Delay&(dti&) LIBRARY "dos"
  32. DECLARE FUNCTION Seek&(fh&,p&,m&) LIBRARY "dos"
  33.  
  34. {*** ASCII to ANSI conversion: setup ***}
  35.  
  36. DIM dbfansi$(300)
  37. RESTORE 
  38. FOR i%=0 TO 257
  39.   READ t%
  40.   dbfansi$(i%)=CHR$(t%)
  41. NEXT i%
  42.  
  43. {*** Main ***}
  44.  
  45. back$=FILEBOX$(".DBF-Datei anzeigen")
  46.  
  47. IF back$>"" THEN
  48.   {*** Open file ***}
  49.   fhbuf&=AllocMem&(DBFBUFLEN&,65539&)
  50.   bac$=back$+CHR$(0)
  51.   back&=SADD(bac$)
  52.   fhdos&=_Open&(back&,1004)
  53.   r&=_Read&(fhdos&,fhbuf&,1)
  54.   dbfvers$=CHR$(PEEK(fhbuf&))
  55.   dbf&=ASC(dbfvers$) {*** dBase version flag ***}
  56.   update$=empty$ {*** holds creation date... ***}
  57.   r&=_Read(fhdos&,fhbuf&,1)
  58.   update$=STR$(PEEK(fhbuf&))
  59.   r&=_Read(fhdos&,fhbuf&,1)
  60.   update$=STR$(PEEK(fhbuf&))+"."+update$
  61.   r&=_Read(fhdos&,fhbuf&,1)
  62.   update$=STR$(PEEK(fhbuf&))+"."+update$
  63.   r&=_Read&(fhdos&,fhbuf&,4)
  64.   intelinteger$=CHR$(PEEK(fhbuf&+3))+CHR$(PEEK(fhbuf&+2))+CHR$(PEEK(fhbuf&+1))+CHR$(PEEK(fhbuf&))
  65.   reccount&=XBCVL(intelinteger$) {*** record count ***}
  66.   r&=_Read&(fhdos&,fhbuf&,2)
  67.   intelinteger$=CHR$(PEEK(fhbuf&+1))+CHR$(PEEK(fhbuf&))
  68.   headerlength&=XBCVI(intelinteger$)
  69.   r&=_Read&(fhdos&,fhbuf&,2)
  70.   intelinteger$=CHR$(PEEK(fhbuf&+1))+CHR$(PEEK(fhbuf&))
  71.   reclength&=XBCVI(intelinteger$) {*** record length ***}
  72.   fieldcount&=(headerlength&-1)/32-1
  73.   {*** Processing dBase file header information ***}
  74.   DIM fld_nam$(257),fldtyp$(257),fldadr&(257)
  75.   DIM fldlen&(257),fld_dec&(257)
  76.   dbf$="<unknown>"
  77.   dbt$=dbf$
  78.   db3p$="Ashton Tate dBASE III+"
  79.   fp25$="Microsoft FoxPro 2.5"
  80.   la3$="Lotus Approach 3.0 [dBASE IV]"
  81.   IF dbf&=3 THEN
  82.     dbf$=db3p$
  83.     dbt$="<none>"
  84.   END IF
  85.   IF dbf&=131 THEN
  86.     dbf$=db3p$
  87.     dbt$=LEFT$(back$,LEN(back$)-3)+"DBT"
  88.   END IF
  89.   IF dbf&=139 THEN
  90.     dbf$=la3$
  91.     dbt$=LEFT$(back$,LEN(back$)-3)+"DBT"
  92.   END IF
  93.   IF dbf&=245 THEN
  94.     dbf$=fp25$
  95.     dbt$=LEFT$(back$,LEN(back$)-3)+"FPT"
  96.   END IF
  97.   {*** Display header information ***}
  98.   PRINT "1. File"
  99.   PRINT "--------"
  100.   PRINT
  101.   PRINT "Name:          ";back$
  102.   PRINT "Version :      ";dbf$
  103.   PRINT "Memos:         ";dbt$
  104.   PRINT "Date:          ";update$
  105.   PRINT "Fields:        ";fieldcount&
  106.   PRINT "Records:       ";reccount&
  107.   PRINT "Header length: ";headerlength&
  108.   PRINT
  109.   INPUT , a$
  110.   field&=0
  111.   FOR i& = 1 TO fieldcount&
  112.     CLS
  113.     PRINT "2. Fields"
  114.     PRINT "---------"    
  115.     PRINT
  116.     r&=Seek&(fhdos&,(32*i&),(-1&))
  117.     r&=_Read&(fhdos&,fhbuf&,11&)
  118.     POKE fhbuf&+11,0
  119.     PRINT "Field: ";i&
  120.     fldnam$=CSTR(fhbuf&)
  121.     fld_nam$(i&)=fldnam$:
  122.     PRINT "Name: ";fld_nam$(i&)
  123.     r&=_Read&(fhdos&,fhbuf&,1&)
  124.     fldtyp$(i&)=CHR$(PEEK(fhbuf&))
  125.     PRINT "Type: ";fldtyp$(i&)
  126.     r&=_Read&(fhdos&,fhbuf&,4&)
  127.     intelinteger$=CHR$(PEEK(fhbuf&+3))+CHR$(PEEK(fhbuf&+2))+CHR$(PEEK(fhbuf&+1))+CHR$(PEEK(fhbuf&))
  128.     fldadr&(i&)=XBCVL(intelinteger$)
  129.     PRINT "Address: ";fldadr&(i&)
  130.     r&=_Read&(fhdos&,fhbuf&,1&)
  131.     fldlen&(i&)=PEEK(fhbuf&)
  132.     PRINT "Length: ";fldlen&(i&);",";
  133.     r&=_Read&(fhdos&,fhbuf&,1&)
  134.     fld_dec&(i&)=PEEK(fhbuf&)
  135.     PRINT fld_dec&(i&)
  136.     IF fldtyp$(i&)="M" THEN
  137.       q&(i&)=0
  138.     ELSE
  139.       ++field&
  140.       q&(i&)=fldlen&(i&)
  141.     END IF
  142.     IF fldtyp$(i&)="D" THEN
  143.       q&(i&)=q&(i&)+2
  144.     END IF
  145.     INPUT , a$
  146.   NEXT i&
  147.     CLS
  148.     PRINT "3. Record contents"
  149.     PRINT "------------------"
  150.     PRINT
  151.     ic$="J"
  152.   PRINT "Convert IBM ASCII to ANSI (Y|N) ";
  153.   INPUT ic$
  154.   IF UCASE$(ic$)="Y" THEN
  155.     ic! = 1 {*** ANSI conversion flag ***}
  156.   ELSE
  157.     ic! = 0
  158.   END IF
  159.   PRINT
  160.   PRINT
  161.   i&=1
  162.   WHILE UCASE$(proceed$)<>"Q"
  163.     p&=Seek&(fhdos&,headerlength&+reclength&*(i&-1),-1&)
  164.     r&=_Read&(fhdos&,fhbuf&,1&)
  165.     recdel$=CHR$(PEEK(fhbuf&)) {*** record deletion mark set by dBase ***}
  166.     out$= empty$
  167.     CLS
  168.     PRINT "3. Record contents"
  169.     PRINT "------------------"
  170.     PRINT
  171.     PRINT "Record: ";i&;
  172.     LOCATE CSRLIN,50
  173.     IF recdel$="*" THEN
  174.       PRINT "*Deleted*"
  175.     END IF
  176.     PRINT
  177.     FOR t&=1 TO fieldcount&
  178.       PRINT fld_nam$(t&);":";
  179.       LOCATE CSRLIN,15
  180.       r&=_Read&(fhdos&,fhbuf&,fldlen&(t&))
  181.       POKE fhbuf&+fldlen&(t&),0
  182.       a$=CSTR(fhbuf&)
  183.       d$ = empty$
  184.       ft$= fldtyp$(t&)
  185.       IF ft$ = "C" THEN {*** character ***}
  186.         IF ic! THEN
  187.           d$=ibm2ansi(a$)
  188.         ELSE
  189.           d$=a$
  190.         END IF
  191.       END IF
  192.       IF ft$ = "N" THEN {*** number ***}
  193.         IF fld_dec&(t&)=0 THEN
  194.           d$=a$
  195.         ELSE
  196.           d$=LEFT$(a$,fldlen&(t&)-fld_dec&(t&)-1)+"."+MID$(a$,fldlen&(t&)-fld_dec&(t&)+1)
  197.           IF LEFT$(d$,1)="." THEN
  198.             d$=MID$(d$,2)
  199.           END IF
  200.         END IF
  201.         uix&=INSTR(d$,",")
  202.         IF uix&<>0 THEN
  203.           d$=LEFT$(d$,uix&)+"."+MID$(d$,uix& + 1)
  204.         END IF
  205.       END IF
  206.       IF ft$ = "D" THEN {*** date ***}
  207.         d$=RIGHT$(a$,2)+"."+MID$(a$,5,2)+"."+LEFT$(a$,4)
  208.       END IF
  209.       IF ft$ = "M" THEN {*** memo ***}
  210.         d$="<Memos are not supported>"
  211.       END IF
  212.       IF ft$="L" THEN {boolean / logical}
  213.         d$=a$
  214.       END IF
  215.       PRINT d$ {*** field contents ***}
  216.       {You can convert the dBase file to a sequential file by writing the string
  217.        d$ to disk. Have a look at the ACE documentation to see how sequential
  218.        files are handled.}
  219.       IF INKEY$<>"" THEN
  220.         INPUT , x$
  221.       END IF
  222.     NEXT t&
  223.     INPUT , proceed$ {*** Proceed? ***}
  224.     IF proceed$="+" THEN
  225.       ++i&
  226.     END IF
  227.     IF proceed$="*" THEN
  228.       i& = i& + 10
  229.     END IF
  230.     IF proceed$="-" THEN
  231.       --i&
  232.     END IF
  233.     IF proceed$="_" THEN
  234.       i& = i& - 10
  235.     END IF  
  236.     IF (i& > reccount&) THEN
  237.       i&=1
  238.     END IF
  239.     IF (i& < 1) THEN
  240.       i&=reccount&
  241.     END IF
  242.   WEND
  243.   {*** Cleanup ***}
  244.   r&=_Close&(fhdos&)
  245.   r&=FreeMem&(fhbuf&,DBFBUFLEN&)
  246. END IF
  247. WINDOW CLOSE 5
  248. END
  249.  
  250. SUB STRING ibm2ansi(tvi$)
  251. {This sub converts an ASCII string to ANSI.}
  252.   SHARED dbfansi$
  253.   FOR tt&=1 TO LEN(tvi$)
  254.     ft%=ASC(MID$(tvi$,tt&,1))
  255.     tvw$=dbfansi$(ft%)
  256.     IF (ASC(tvw$) <> 1) THEN
  257.       ibm2a$=ibm2a$+tvw$
  258.     END IF
  259.   NEXT tt&
  260.  ibm2ansi=ibm2a$
  261. END SUB
  262.  
  263. SUB STRING trim(a$)
  264. {Deletes leading / trailing blanks and control characters.}
  265.   tr$ = empty$
  266.   FOR tr& = 1 TO LEN(a$)
  267.     IF ((ASC(MID$(a$,tr&,1))) AND 127) > 32 THEN
  268.       tr$=tr$+MID$(a$,tr&,1)
  269.     END IF
  270.   NEXT tr&
  271.   trim=tr$
  272. END SUB
  273.  
  274. SUB XBCVI(A$)
  275. {Emulates the CVI() function of standard Basic. It converts a string of
  276.  one or to bytes to an integer value.}
  277.   IF LEN(a$) = 2 THEN
  278.     XBCVI=ASC(left$(a$,1))*256 + ASC(RIGHT$(a$,1))
  279.   ELSE
  280.     XBCVI = ASC(a$)
  281.   END IF
  282. END SUB
  283.  
  284. SUB XBCVL(a$)
  285. {Emulates the CVL() function of standard Basic. It converts a four byte
  286.  string to a long integer value.}
  287.   cv = ASC(MID$(a$,1,1))
  288.   cv = cv + ASC(MID$(a$,2,1)) * 256
  289.   cv = cv + ASC(MID$(a$,3,1)) * 65536
  290.   cv = cv + ASC(MID$(a$,4,1)) * 16777216
  291.   XBCVL = cv
  292. END SUB
  293.  
  294. {*** Data for ASCII to ANSI conversion ***}
  295.  
  296. DATA 1, 1, 1, 1, 1, 1, 1, 183, 176, 1, 1, 1, 1, 1, 1, 45, 1, 1
  297. DATA 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 32, 33, 34, 35, 36
  298. DATA 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55
  299. DATA 56, 57, 58, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74
  300. DATA 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, 93
  301. DATA 94, 95, 96, 97, 98, 99, 100, 101, 102, 103, 104, 105, 106, 107, 108, 109
  302. DATA 110, 111, 112, 113, 114, 115, 116, 117, 118, 119, 120, 121, 122, 123, 124
  303. DATA 125, 126, 1, 199, 252, 233, 226, 228, 224, 229, 231, 234, 235, 232, 239
  304. DATA 238, 236, 196, 197, 201, 230, 198, 244, 246, 242, 251, 249, 255, 214, 220
  305. DATA 162, 163, 165, 1, 1, 225, 237, 243, 250, 241, 209, 170, 186, 191, 1, 172
  306. DATA 189, 188, 161, 171, 187, 1, 1, 1, 124, 1, 1, 1, 1, 1, 1, 1, 1
  307. DATA 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1
  308. DATA 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1
  309. DATA 223, 1, 182, 1, 1, 181, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 177, 1
  310. DATA 1, 1, 1, 1, 1, 176, 183, 183, 1, 1, 178, 183, 32, 1, 1, 1, 1, 1
  311.  
  312.